home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
browse.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-06-25
|
9KB
|
276 lines
program lit;
uses crt,dos;
const pgup = #73;
fleh = #72;
pgdn = #81;
fleb = #80;
home_= #71;
end_ = #79;
esc = 27;
ret = 13;
dl : Char = 'M';
ls : Char = '5';
rs : Char = 'F';
up : Char = #24;
dn : Char = #25;
sl : Char = 'D';
blanc =' ';
max_char_par_ligne = 79;
max_ligne_par_page = 22;
nom_du_fichier : string[30]='d:\compus\astroc.txt';
ecran ='monoherc';
type
pagetype = array[1..max_ligne_par_page] of string[max_char_par_ligne];
dll = ^ dlr;
dlr = record
no :integer;
page :pagetype;
suivant:dll;
prede :dll;
end;
var fi : text;
pred,
tempo ,
debut,t : dll;
r,r_ : char;
page_temp: pagetype;
i,j,k : integer;
ou ,npagetot : integer;
by : real;
mlp,mcl,orr:real;
fk : boolean;
{---------------------------------------------------------------------}
procedure scr(npagetot :integer);
var
j:integer;
begin
window(1,24,80,25);
clrscr;
textcolor(15);
textbackground(0);
gotoxy(1,1); for j:=1 to 80 do write(sl);
gotoxy(1,2); write('Pgup ',#24);
GotoXY(8,1); write('B');
GotoXY(8,2); write('3');
gotoxy(9,2); write ('Pgdn ',#25);
GotoXY(16,1); write('B');
GotoXY(16,2); write('3');
gotoxy(17,2); write('Home ');
GotoXY(23,1); write('B');
GotoXY(23,2); write('3');
gotoxy(24,2); write('End ');
GotoXY(31,1); write('B');
GotoXY(31,2); write('3');
gotoxy(32,2); write('Esc ');
GotoXY(42,1); write('B');
GotoXY(42,2); write('3');
gotoxy(43,2); write('Page:');write(' ');write('/');
gotoxy(53,2); write(npagetot:5);
GotoXY(58,1); write('B');
GotoXY(58,2); write('3');
if length(nom_du_fichier) > 18 then begin
for i:=1 to 18 do write(nom_du_fichier[i]);
write('...');
end
else write(nom_du_fichier);
textcolor(7);
textbackground(0);
window(1,1,80,23);
end;
{---------------------------------------------------------------------}
procedure a_jour(num :integer);
var x,y :integer;
s : char;
begin
x := wherex; y := wherey;
window(48,24,51,25);
textcolor(7);
textbackground(0);
gotoxy(1,2);
clreol;
write( num :3 );
window(1,1,80,23);
end;
{-------------------------------------------------------------------}
procedure curseur(size:char);
var regis : registers;
begin
size := upcase (size);
if ecran = 'Monoherc' then
i := 6
else
i := 6;{0 initialement}
regis.ah := $01;
if size ='O' then
begin
regis.ch :=$20;
regis.cl :=$00;
end
else if size ='B' then
begin
regis.ch := 0;
regis.cl := 7 +i;
end
else begin
regis.ch := 6 + i;
regis.cl := 7 + i;
end;
intr($10,regis);
end;
{-------------------------------------------------------------------}
procedure creer_liste_double(VAR npagetot :integer);
begin
k:=1;
ou :=1;
clrscr;
mlp :=max_ligne_par_page;
mcl :=max_char_par_ligne;
assign(fi,nom_du_fichier); reset(fi);
debut := nil;
while not(eof(fi)) do begin
if debut = nil then begin
for j := 1 to max_ligne_par_page do
readln(fi,page_temp[j]);
new(tempo);
tempo^.no:=ou;
debut :=tempo;
pred := tempo;
tempo^.suivant := nil;
tempo^.prede := nil;
for j := 1 to max_ligne_par_page do
tempo^.page[j] := page_temp[j] ;
end
else begin
for j := 1 to max_ligne_par_page do
readln(fi,page_temp[j]);
k:= k+1;
ou := ou+1;
pred := tempo;
new(tempo);
tempo^.no:=ou;
pred^.suivant := tempo;
tempo^.prede := pred;
tempo^.suivant:= nil;
for j := 1 to max_ligne_par_page do
tempo^.page[j] := page_temp[j] ;
pred:= tempo;
end;
orr :=ou;
by := orr*mlp*mcl;
gotoxy(36,8); write('Pegase (c).');
gotoxy(30,10);write('Lignes lues : ');clreol;write(max_ligne_par_page*ou);
gotoxy(30,12);write('Bytes lus :');clreol;write(by :10:0);
gotoxy(30,14);write('KBytes lus :');clreol;write(by/1024 :10:2);
gotoxy(30,16);write('Tas (Bytes) :');clreol;write( maxavail:10);
gotoxy(30,18);write('Tas (KBytes):');clreol;write( maxavail/1024 :10:2);
end;
tempo^.suivant := debut;
debut^.prede := tempo;
close(fi);
npagetot := k;
end;
{-------------------------------------------------------------------}
{main}
begin
textcolor(15);
textbackground(0);
curseur('o');
creer_liste_double(npagetot);
scr(npagetot);
r:=' ';
new(tempo);
tempo :=debut;
pred :=nil;
repeat
if tempo <> nil then begin
textcolor(0);
textbackground(7);
clrscr;
for j := 1 to max_ligne_par_page do
writeln(tempo^.page[j]);
a_jour(tempo^.no);
window(1,1,80,23);
fk := false;
r := readkey;
if r = #0 then begin
fk := true;
case readkey of
fleb, pgdn :begin
tempo := tempo^.suivant;
end;
fleh, pgup : begin
tempo := tempo^.prede;;
end;
home_ : tempo := debut;
end_ : begin
for i:= 1 to (npagetot-tempo^.no) do
tempo := tempo